home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / pgm_ing / kwshare / kwcode.mdb / code.json
Encoding:
JavaScript Object Notation  |  1996-01-02  |  8.5 KB
  1. {
  2.     "schema": {
  3.         "SubFuncName": "Text (250)",
  4.         "SubFuncBody": "Memo/Hyperlink (255)"
  5.     },
  6.     "data": [
  7.         {
  8.             "SubFuncName": "lbl_dragto_DragOver",
  9.             "SubFuncBody": "Sub lbl_dragto_DragOver (Source As Control, X As Single, Y As Single, State As Integer)\r\n\r\n'invert text/background colors when target is in focus\r\n\r\nDim tempcolor& 'long\r\n\r\nIf State = ENTER Or State = LEAVE Then\r\n   tempcolor = lbl_dragto.BackColor\r\n   lbl_dragto.BackColor = lbl_dragto.ForeColor\r\n   lbl_dragto.ForeColor = tempcolor\r\nEnd If\r\n\r\n\r\nEnd Sub\r\n"
  10.         },
  11.         {
  12.             "SubFuncName": "Open_Dialog",
  13.             "SubFuncBody": "Function Open_Dialog (prm_caption$, prm_filter$, prm_flags%, prm_action%, thefiletitle) As String\r\n\r\nOn Error Resume Next\r\nCMDialog1.CancelError = -1\r\nCMDialog1.DialogTitle = prm_caption\r\nCMDialog1.Filter = prm_filter\r\nCMDialog1.Flags = prm_flags\r\nCMDialog1.Action = prm_action\r\n\r\nIf Err = 0 Then\r\n    Open_Dialog = CMDialog1.Filename\r\n    thefiletitle = CMDialog1.Filetitle\r\nEnd If\r\n\r\n\r\nEnd Function\r\n"
  14.         },
  15.         {
  16.             "SubFuncName": "ReadArray",
  17.             "SubFuncBody": "Function ReadArray (VBFileNumber As Integer) As Long\r\n\r\n   Dim arraysize As Long, ApiErr&\r\n   Dim DOSFileHandle As Integer\r\n   Dim ReadFromDisk As Integer\r\n\r\n   arraysize = Abs(UBound(filestrarray) - LBound(filestrarray)) + 1\r\n   arraysize = arraysize * Len(filestrarray(LBound(filestrarray)))\r\n\r\n   If arraysize > 32767 Then\r\n      ReadFromDisk = arraysize - 2 ^ 15\r\n      ReadFromDisk = ReadFromDisk * -1\r\n   Else\r\n      ReadFromDisk = arraysize\r\n   End If\r\n\r\n\r\n   DOSFileHandle = FileAttr(VBFileNumber, 2)\r\n   ApiErr = fRead(DOSFileHandle, filestrarray(LBound(filestrarray)), ReadFromDisk)\r\n\r\n   ReadArray = ApiErr\r\nEnd Function\r\n"
  18.         },
  19.         {
  20.             "SubFuncName": "GetSubFuncStr",
  21.             "SubFuncBody": "Sub GetSubFuncStr (subname$)\r\n'When the user clicks on a sub or function name the corresponding text is displayed\r\nDim ctr1&, ctr2&, startat&, ch$, aline$, backtrack&\r\nDim IsEnd%, substart&\r\n\r\nstartat = 1\r\nctr2 = 1\r\nsubtext = \"\" 'module level dim\r\n\r\n Do\r\n   ch = \"\"\r\n   aline = \"\"\r\n   ctr1 = InStr(ctr2, filestr, subname)'find the subfunc name in the file\r\n   If ctr1 = 0 Then\r\n     MsgBox \"couldn't find\" & subname\r\n     Exit Sub\r\n   End If\r\n   startat = ctr1 - 2 'backtrack to the start of the last word\r\n   Do Until ch = Chr$(13) Or ch = Chr$(10)\r\n    aline = aline + ch\r\n    ch = Mid$(filestr, startat, 1)\r\n    startat = startat - 1\r\n   Loop\r\n   If StrComp(LTrim(aline), \"buS\") = 0 Then\r\n     substart = startat\r\n     IsEnd = False\r\n     Do\r\n       ctr1 = InStr(startat, filestr, \"End Sub\")\r\n       If ctr1 = 0 Then Exit Sub\r\n\t  backtrack = ctr1 - 1\r\n\t  Do\r\n\t    ch = Mid$(filestr, backtrack, 1)\r\n\t    If ch = Chr$(10) Or ch = Chr$(13) Then\r\n\t       IsEnd = True\r\n\t       Exit Do\r\n\t       Else\r\n\t\t   startat = startat + 7\r\n\t\t   Exit Do\r\n\t    End If\r\n\t    backtrack = backtrack - 1\r\n\t  Loop While ch = \" \"\r\n     Loop While IsEnd = False\r\n     subtext = Mid$(filestr, substart + 2, (ctr1 + 7) - substart)\r\n     Exit Do\r\n     Else\r\n\tIf StrComp(LTrim(aline), \"noitcnuF\") = 0 Then\r\n\t   substart = startat\r\n\t   IsEnd = False\r\n\t   Do\r\n\t     ctr1 = InStr(startat, filestr, \"End Function\")\r\n\t     If ctr1 = 0 Then Exit Sub\r\n\t\tbacktrack = ctr1 - 1\r\n\t\tDo\r\n\t\t  ch = Mid$(filestr, backtrack, 1)\r\n\t\t  If ch = Chr$(10) Or ch = Chr$(13) Then\r\n\t\t     IsEnd = True\r\n\t\t     Exit Do\r\n\t\t     Else\r\n\t\t\tstartat = startat + 7\r\n\t\t\tExit Do\r\n\t\t  End If\r\n\t\t  backtrack = backtrack - 1\r\n\t\tLoop While ch = \" \"\r\n\t   Loop While IsEnd = False\r\n\t   subtext = Mid$(filestr, substart + 2, ctr1 + 12 - substart)\r\n\t   Exit Do\r\n\t   Else\r\n\t      If StrComp(LTrim(aline), \"buS citatS\") = 0 Then\r\n\t\t substart = startat\r\n\t\t IsEnd = False\r\n\t\t Do\r\n\t\t   ctr1 = InStr(startat, filestr, \"End Sub\")\r\n\t\t   If ctr1 = 0 Then Exit Sub\r\n\t\t      backtrack = ctr1 - 1\r\n\t\t      Do\r\n\t\t\tch = Mid$(filestr, backtrack, 1)\r\n\t\t\tIf ch = Chr$(10) Or ch = Chr$(13) Then\r\n\t\t\t   IsEnd = True\r\n\t\t\t   Exit Do\r\n\t\t\t   Else\r\n\t\t\t       startat = startat + 7\r\n\t\t\t       Exit Do\r\n\t\t\tEnd If\r\n\t\t\tbacktrack = backtrack - 1\r\n\t\t      Loop While ch = \" \"\r\n\t\t Loop While IsEnd = False\r\n\t\t subtext = Mid$(filestr, substart + 2, (ctr1 + 7) - substart)\r\n\t\t Exit Do\r\n\t\t Else\r\n\t\t If StrComp(LTrim(aline), \"noitcnuF citatS\") = 0 Then\r\n\t\t    substart = startat\r\n\t\t    IsEnd = False\r\n\t\t    Do\r\n\t\t      ctr1 = InStr(startat, filestr, \"End Function\")\r\n\t\t      If ctr1 = 0 Then Exit Sub\r\n\t\t\t backtrack = ctr1 - 1\r\n\t\t\t Do\r\n\t\t\t   ch = Mid$(filestr, backtrack, 1)\r\n\t\t\t   If ch = Chr$(10) Or ch = Chr$(13) Then\r\n\t\t\t      IsEnd = True\r\n\t\t\t      Exit Do\r\n\t\t\t      Else\r\n\t\t\t\t  startat = startat + 7\r\n\t\t\t\t  Exit Do\r\n\t\t\t   End If\r\n\t\t\t   backtrack = backtrack - 1\r\n\t\t\t Loop While ch = \" \"\r\n\t\t    Loop While IsEnd = False\r\n\t\t    subtext = Mid$(filestr, substart + 2, ctr1 + 12 - substart)\r\n\t\t    Exit Do\r\n\t\tEnd If\r\n\t    End If\r\n\tEnd If\r\n\tctr2 = ctr1 + 2\r\n     End If\r\n Loop While ctr2 <= Len(filestr)\r\nEnd Sub\r\n"
  22.         },
  23.         {
  24.             "SubFuncName": "CheckGlobalMatch",
  25.             "SubFuncBody": "Function CheckGlobalMatch (globalword$) As Integer\r\n\r\nDim firstword&, secondword&, startat&, atleasttwo%, retval%, ctr%, ctr2%, ctr3%\r\nDim stopstr$, checkboundry$, aline$\r\n\r\nstopstr = \" ,%$#@!&().-+*^{}[]';\" & Chr$(9) & Chr$(10) & Chr$(13)\r\nstartat = 1\r\n\r\nlbl_seek.Caption = globalword\r\n\r\n\r\nFor ctr = LBound(filestrarray) To UBound(filestrarray)\r\n    aline = Mid$(filestrarray(ctr), startat, Len(filestrarray(ctr)) - startat + 1)\r\n    ctr2 = ctr + 1\r\n    Do\r\n      If ctr2 <= UBound(filestrarray) Then\r\n       ctr3 = InStr(1, filestrarray(ctr2), \" \")\r\n       If ctr3 Then\r\n\t  aline = aline & Mid$(filestrarray(ctr2), 1, ctr3)\r\n\t  \r\n\t  startat = ctr3\r\n\t  Else\r\n\t     aline = aline & filestrarray(ctr2)\r\n\t     ctr2 = ctr2 + 1\r\n\t     ctr = ctr2\r\n\t     startat = 1\r\n\t     \r\n       End If\r\n      End If\r\n    Loop Until Right$(aline, 1) = \" \" Or ctr2 >= UBound(filestrarray)\r\n\r\n\r\n    firstword = InStr(1, aline, globalword)\r\n    If firstword Then\r\n       If firstword = 1 Then\r\n\t  checkboundry = Right$(aline, 1)\r\n\t  Else\r\n\t      checkboundry = Mid$(aline, firstword - 1, 1)\r\n\t      If InStr(1, stopstr, checkboundry) Then\r\n\t\t If firstword + Len(globalword) - 1 < Len(aline) Then\r\n\t\t    checkboundry = Mid$(aline, firstword + Len(globalword), 1)\r\n\t\t    If InStr(1, stopstr, checkboundry) Then\r\n\t\t       atleasttwo = atleasttwo + 1\r\n\t\t       If atleasttwo > 1 Then\r\n\t\t\t  CheckGlobalMatch = atleasttwo\r\n\t\t\t  globalused = globalused + 1\r\n\t\t\t  lbl_keep.Caption = globalused\r\n\t\t\t  Exit Function\r\n\t\t\tEnd If\r\n\t\t\tsecondword = InStr(firstword + 1, aline, globalword)\r\n\t\t\tIf secondword Then\r\n\t\t\t   If secondword = 1 Then\r\n\t\t\t      checkboundry = Right$(aline, 1)\r\n\t\t\t      Else\r\n\t\t\t\t  checkboundry = Mid$(aline, secondword - 1, 1)\r\n\t\t\t\t  If InStr(1, stopstr, checkboundry) Then\r\n\t\t\t\t     If secondword + Len(globalword) - 1 < Len(aline) Then\r\n\t\t\t\t\tcheckboundry = Mid$(aline, secondword + Len(globalword), 1)\r\n\t\t\t\t\tIf InStr(1, stopstr, checkboundry) Then\r\n\t\t\t\t\t   atleasttwo = atleasttwo + 1\r\n\t\t\t\t\t   If atleasttwo > 1 Then\r\n\t\t\t\t\t      CheckGlobalMatch = atleasttwo\r\n\t\t\t\t\t      globalused = globalused + 1\r\n\t\t\t\t\t      lbl_keep.Caption = globalused\r\n\t\t\t\t\t      Exit Function\r\n\t\t\t\t\t   End If\r\n\t\t\t\t\tEnd If\r\n\t\t\t\t     End If\r\n\t\t\t\t  End If\r\n\t\t\t   End If\r\n\t\t\tEnd If\r\n\t\t     End If\r\n\t\tEnd If\r\n\t     End If\r\n\t  End If\r\n   End If\r\nDoEvents\r\nNext\r\n\r\nIf frm_Options.chk_promptglobal.Value = True Then\r\n   retval = MsgBox(\"Cant find a match for \" & globalword, MB_YESNOCANCEL Or MB_ICONQUESTION, \"Delete?\")\r\n   If retval = IDYES Then\r\n      CheckGlobalMatch = atleasttwo\r\n      globaldis = globaldis + 1\r\n      lbl_removed.Caption = globaldis\r\n      Else\r\n\t If retval = IDNO Then\r\n\t    globalused = globalused + 1\r\n\t    lbl_keep.Caption = globalused\r\n\t    CheckGlobalMatch = 2\r\n\t    Else\r\n\t       If retval = IDCANCEL Then\r\n\t\t  frm_Options.chk_promptglobal.Value = False\r\n\t       End If\r\n\t End If\r\n   End If\r\n   Else\r\n   CheckGlobalMatch = atleasttwo\r\n   globaldis = globaldis + 1\r\n   lbl_removed.Caption = globaldis\r\nEnd If\r\n\r\nEnd Function\r\n"
  26.         }
  27.     ]
  28. }